3. Mes premiers pas de TAListe: topic modeling, LDA et alii
Simon Gabay
12/10/2021
1. Préparatifs
J’installe ma session de travail
setwd("~/Documents/github/UNIGE/32M7129/Cours_03")
monDossier="~/Documents/github/UNIGE/32M7129/Cours_03"
#je charge les données que l'enseignant a préparé pour éviter les problèmes
#load("Cours_Geneve_3.RData")Première chose à faire: importer le corpus qui se trouve dans le
dossier cours 3. Comme il s’agit d’un csv, nous utilisons
la fonction read.csv() Le corpus que nous importons est une
collection de blocs d’environ 1000 mots lemmatisés. (notez la présence
de lignes commençant par un dièse. Il s’agit d’un commentaire: quand il
est utilisé, la ligne n’est pas interprétée par R)
theatre = "moliere_racine.tsv"
# le paramètre `header` permet de signaler que la première ligne contient le nom des colonnes
# le paramètre `sep` permet d'indiquer comment sont marquées les colonnes. La regex `\t` indique que nous utilisons des tabulations (notre fichier est donc en fait un `tsv` et non un vrai `csv`).
# le paramètre fileEncoding permet d'avoir des charactères encodés en UTF8 (si vous avez windows, sans cette option le résultat de l'import peut être problématique)
theatre <- read.csv(theatre, header=TRUE, sep = "\t", quote = '',fill = TRUE, fileEncoding="UTF-8")Je peux jeter un coup d’œil aux données brutes (on ne m’affiche que les première entrées de chaque colonne par commodité)
str(theatre)## 'data.frame': 724 obs. of 8 variables:
## $ auteur : chr "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\"" "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\"" "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\"" "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\"" ...
## $ titre : chr "\"AMPHITRYON, COMÉDIE\"" "\"AMPHITRYON, COMÉDIE\"" "\"AMPHITRYON, COMÉDIE\"" "\"AMPHITRYON, COMÉDIE\"" ...
## $ date : chr "\"1668\"" "\"1668\"" "\"1668\"" "\"1668\"" ...
## $ genre : chr "\"Comédie\"" "\"Comédie\"" "\"Comédie\"" "\"Comédie\"" ...
## $ inspiration: chr "\"mythe grec\"" "\"mythe grec\"" "\"mythe grec\"" "\"mythe grec\"" ...
## $ structure : chr "\"Trois actes, un prologue\"" "\"Trois actes, un prologue\"" "\"Trois actes, un prologue\"" "\"Trois actes, un prologue\"" ...
## $ type : chr "\"vers\"" "\"vers\"" "\"vers\"" "\"vers\"" ...
## $ texteLemmat: chr "\" tout beau charmant nuit daigner vous arrêter il être certain secours que de vous on désirer "| __truncated__ "\" de_le nuit que à son transport vous donner plus de espace et retarder le naissance de_le jou"| __truncated__ "\" jamais croire raconter je sosie un tel événement \" \" je le vouloir bien madame et sans je"| __truncated__ "\" être son valet tu je son valet sans doute valet de amphitryon de amphitryon de il ton nom "| __truncated__ ...Je peux aussi les regarder dans un tableau directement dans RStudio. On remarque que les colonnes ont des noms: “auteur”, “titre”…
View(theatre)Je peux sélectionner juste une colonne (ici “auteur”). Afin de ne pas
tout afficher j’utilise la fonction head() pour ne montrer
que les premières entrées:
head(theatre$auteur)## [1] "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\""
## [2] "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\""
## [3] "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\""
## [4] "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\""
## [5] "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\""
## [6] "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\""# Je peux augmenter le nombre de résultat affiché en indiquant le chiffre souhaité de la manière suivante:
#head(theatre$auteur,10)
#Pour les dernières entrées, il existe une fonction `tail`
#tail(theatre$auteur)Toutes les colonnes sont des métadonnées, sauf
theatre$texteLemmat qui contient des “morceaux” de pièces
de 1000 mots afin de simplifier le travail (nous allons y revenir). Il
va falloir transformer le contenu de cette colonne en matrice
terme-document (Document Term Matrix), c’est-à-dire créer un
tableau avec une colonne pour chaque mot de mon corpus, et un rang par
texte de mon corpus.
| mot1 | mot2 | mot3 | |
|---|---|---|---|
| Texte1 | 1 | 12 | 9 |
| Texte2 | 1 | 154 | 4 |
C’est le principe d’une approche bag of words, c’est à dire par “sac de mots”: les mots ne sont pas pris dans leur contexte, uniquement par leur fréquence. Cela peut paraître un peu rustre, mais c’est très efficace.
#Je charge deux nouvelles librairies pour le _text mining_ qui me permettent de créer ma matrice
if(!require("tm")){s
install.packages("tm")
library("tm")
}## Le chargement a nécessité le package : tm## Le chargement a nécessité le package : NLPif(!require("tidytext")){
install.packages("tidytext")
library("tidytext")
}## Le chargement a nécessité le package : tidytext# Je transforme mes textes en corpus avec la fonction `corpus()`, un objet de classe `corpus` manipulable dans `R` contenant des données et des métadonnées
#La fonction `VectorSource` transforme chaque document en vecteur
corpus <- Corpus(VectorSource(theatre$texteLemmat), readerControl = list(language = "fr"))
# J'affiche les informations à propos de ce corpus
corpus## <<SimpleCorpus>>
## Metadata: corpus specific: 1, document level (indexed): 0
## Content: documents: 724Je peux désormais “utiliser” cet objet:
#je compte le nombre de colonne dans ma matrice
ncol(as.matrix(DocumentTermMatrix(corpus)))## [1] 8896#J'affiche le premier vecteur de mon objet `corpus`:
corpus[[1]][[1]]## [1] "\" tout beau charmant nuit daigner vous arrêter il être certain secours que de vous on désirer et je avoir deux mot à vous dire de le part de Jupiter ah ah ce être vous seigneur Mercure qui vous avoir deviner là dans ce posture mon foi je trouver las pour ne pouvoir fournir à_le différent emploi où Jupiter je engager je je être doucement asseoir sur ce nuage pour vous attendre venir vous vous moquer Mercure et vous ne y songer pas seoir il bien à de_le dieu de dire que il être las le dieu être il de fer non mais il falloir sans cesse garder le decorum de le divinité il être de certain mot dont le usage rabaisser ce sublime qualité et que pour leur indignité il être bon que à_le homme on laisser à votre aise vous en parler et vous avoir le beau un chaise roulant où par deux bon cheval en dame nonchalant vous vous faire traîner partout où vous vouloir mais de je ce ne être pas de même et je ne pouvoir vouloir dans mon destin fatal à_le poète assez de mal de leur impertinence extrême de avoir par un injuste loi dont on vouloir maintenir le usage à chaque dieu dans son emploi donner quelque allure en partage et de je laisser à pied je comme un messager de village je qui être comme on savoir en terre et dans le ciel le fameux messager de_le souverain de_le dieu et qui sans rien exagérer par tout le emploi que il je donner avoir besoin plus que personne de avoir de quoi je voiturer que vouloir vous faire à cela le poète faire à leur guise ce ne être pas le seul sottise que on voir faire à ce messieurs là mais contre il toutefois votre âme à tort se irriter et votre aile à_le pied être un don de leur soin oui mais pour aller plus vite être ce que on se en las moins laisser cela seigneur Mercure et savoir ce dont il se agir ce être Jupiter comme je vous le avoir dire qui de votre manteau vouloir le faveur obscur pour certain doux aventure que un nouveau amour il fournir son pratique je croire ne vous être pas nouvelle bien souvent pour le terre il négliger le ciel et vous ne ignorer pas que ce maître de_le dieu aimer à se humaniser pour de_le beauté mortel et savoir cent tour ingénieux pour mettre à bout le plus cruel un œil de Alcmène il avoir sentir le coup et tandis que à_le milieu de_le béotique plaine amphitryon son époux commander à_le troupe thébaine il en avoir prendre le forme et recevoir là-dessous un soulagement à son peine dans le possession de_le plaisir le plus doux le état de_le marier à son feu être propice le hymen ne le avoir joindre que depuis quelque jour et le jeune chaleur de leur tendre amour avoir faire que Jupiter à ce beau artifice se être aviser de avoir recours son stratagème ici se trouver salutaire mais près de maint objet chérir pareil déguisement être pour ne rien faire et ce ne être pas partout un bon moyen de plaire que le figure de un mari je admirer Jupiter et je ne comprendre pas tout le déguisement qui il venir en tête il vouloir goûter par là tout sorte de état et ce être agir en dieu qui ne être pas bête dans quelque rang que il être de_le mortel regarder je le tenir fort misérable se il ne quitter jamais son mine redoutable et que à_le faîte de_le ciel il être toujours guinder il ne être point à mon gré de plus sot méthode que de être emprisonner toujours dans son grandeur et surtout à_le transport de le amoureux ardeur le haut qualité devenir fort incommode Jupiter qui sans doute en plaisir se connaître savoir descendre de_le haut de son gloire suprême et pour entrer dans tout ce que il il plaire il sortir tout à faire de il même et ce ne être plus alors Jupiter qui paraître passer encore de le voir de ce sublime étage dans celui de_le homme venir prendre tout le transport que leur cœur pouvoir fournir et se faire à leur badinage si dans le changement où son humeur le engager à le nature humain il se en vouloir tenir mais de voir Jupiter taureau serpent cygne ou quelque autre chose je ne trouver point cela beau et ne je étonner pas si parfois on en cause laisser dire tout le censeur tel changement avoir leur douceur qui passer leur intelligence ce dieu savoir ce que il faire aussi bien là que ailleurs et dans le mouvement de leur tendre ardeur le bête ne être pas si bête que le on penser revenir à le objet dont il avoir le faveur si par son stratagème il voir son flamme heureux que pouvoir il souhaiter et que être ce que je pouvoir que votre cheval par vous à_le petit pas réduire pour satisfaire à_le vœu de son âme amoureux de un nuit si délicieux faire le plus long \""2. Je nettoie mon corpus
Il est absolument fondamental de nettoyer mon corpus de travail. En
effet: pas et Pas ne sont pas les mêmes chaînes de
caractères (il y a une majuscule dans le second), et peut-être même pas
les mêmes mots (adverbe ou substantif?). Je dois donc au moins retirer
les majuscules (avec la fonction tolower()), ou même
lemmatiser (de préférence avec un outil spécifique, qui n’existe pas
dans R).Pour rappel,nous fournissons ici le texte
préalablement lemmatisé pour simplifier le travail.
2.1 Les stopwords
Comme notre objectif est d’avoir une approche thématique et conserver
des mots potentiellement porteurs de sens: il faut donc retirer tous les
mots les plus fréquents qui n’apportent, comme les les pronoms, les
pronoms adverbiaux, les prépositions… Ces mots sont appelés des
stopwords et une liste est fournie dans la fonction
stopwords()
stopwords("french")## [1] "au" "aux" "avec" "ce" "ces" "dans"
## [7] "de" "des" "du" "elle" "en" "et"
## [13] "eux" "il" "je" "la" "le" "leur"
## [19] "lui" "ma" "mais" "me" "même" "mes"
## [25] "moi" "mon" "ne" "nos" "notre" "nous"
## [31] "on" "ou" "par" "pas" "pour" "qu"
## [37] "que" "qui" "sa" "se" "ses" "son"
## [43] "sur" "ta" "te" "tes" "toi" "ton"
## [49] "tu" "un" "une" "vos" "votre" "vous"
## [55] "c" "d" "j" "l" "à" "m"
## [61] "n" "s" "t" "y" "été" "étée"
## [67] "étées" "étés" "étant" "suis" "es" "est"
## [73] "sommes" "êtes" "sont" "serai" "seras" "sera"
## [79] "serons" "serez" "seront" "serais" "serait" "serions"
## [85] "seriez" "seraient" "étais" "était" "étions" "étiez"
## [91] "étaient" "fus" "fut" "fûmes" "fûtes" "furent"
## [97] "sois" "soit" "soyons" "soyez" "soient" "fusse"
## [103] "fusses" "fût" "fussions" "fussiez" "fussent" "ayant"
## [109] "eu" "eue" "eues" "eus" "ai" "as"
## [115] "avons" "avez" "ont" "aurai" "auras" "aura"
## [121] "aurons" "aurez" "auront" "aurais" "aurait" "aurions"
## [127] "auriez" "auraient" "avais" "avait" "avions" "aviez"
## [133] "avaient" "eut" "eûmes" "eûtes" "eurent" "aie"
## [139] "aies" "ait" "ayons" "ayez" "aient" "eusse"
## [145] "eusses" "eût" "eussions" "eussiez" "eussent" "ceci"
## [151] "cela" "celà" "cet" "cette" "ici" "ils"
## [157] "les" "leurs" "quel" "quels" "quelle" "quelles"
## [163] "sans" "soi"Il existe des listes alternatives en ligne, plus complètes:
#Donner un nom au fichier que je télécharge
mesStops="stopwords-fr.csv"
#indiquer l'URL où se trouve le document à télécharger
stopword_enLigne = "https://raw.githubusercontent.com/stopwords-iso/stopwords-fr/master/stopwords-fr.txt"
#télécharger le fichier et l'enregistrer sous le nom que je viens de lui donner
download.file(stopword_enLigne,mesStops)
#Comme c'est un tableur, je le lis avec la fonction adéquat
stopword_enLigne = read.csv(stopword_enLigne, header=FALSE, stringsAsFactors=FALSE)[,]
#je jette un coup d'œil aux 10 premiers
head(stopword_enLigne,10)## [1] "a" "abord" "absolument" "afin" "ah"
## [6] "ai" "aie" "aient" "aies" "ailleurs"Je vais utiliser mes listes de stopwords l’une après l’autre
pour nettoyer mon corpus. Pour cela j’utilise la fonction
tm_map() qui permet de modifier les corpora. Dans ce cas
précise j’utilise removeWords avec chacune des deux
listes.
corpus_clean <- tm_map(corpus, removeWords, stopwords("french"))## Warning in tm_map.SimpleCorpus(corpus, removeWords, stopwords("french")):
## transformation drops documentscorpus_clean <- tm_map(corpus, removeWords, stopword_enLigne)## Warning in tm_map.SimpleCorpus(corpus, removeWords, stopword_enLigne):
## transformation drops documents#Je jette un coup d'œil à la sixième entrée pour contrôler que tout est en ordre
inspect(corpus_clean[6])## <<SimpleCorpus>>
## Metadata: corpus specific: 1, document level (indexed): 0
## Content: documents: 1
##
## [1] " de combien de frayeur avoir le âme blesser à_le moindre choc dont entendre voir dans le horreur de pensée jamais consoler de_le coup dont être menacer et de laurier couronne vainqueur part le avoir à ce honneur suprême valoir il ce il en coûter à_le tendresse de cœur pouvoir à moment trembler ce il aimer je ne voir en dont mon feu ne augmenter marquer à mon œil cœur bien enflammer et ce être je le avouer chose charmant de trouver de amour dans objet aimer mais je le oser dire scrupule je gêne à_le tendre sentiment je faire voir et le bien goûter mon amour cher Alcmène vouloir ne voir entrer de devoir à ardeur à mon je devoir le faveur je recevoir de et le qualité je avoir de époux ne être point ce je le donner ce être de ce nom pourtant le ardeur je brûler le droit de paraître à_le jour et je ne comprendre à ce nouveau scrupule dont embarrasser amour ah ce je avoir de ardeur et de tendresse passer aussi celui de époux et ne savoir dans de_le moment doux en être le délicatesse ne concevoir point cœur bien amoureux cent petit égard attacher avec étude et faire inquiétude de le manière de être heureux en je beau et charmant Alcmène voir mari voir amant mais le amant je toucher à franchement et je sens de le mari le gêne ce amant de vœu jaloux à_le dernier point souhaite à il cœur abandonner et passion ne vouloir point de ce le mari il donner il vouloir de source obtenir ardeur et ne vouloir de_le nœud de le hyménée de fâcheux devoir faire agir le coeur et le jour de_le cher faveur le douceur être empoisonner dans le scrupule enfin dont il être combattre il vouloir satisfaire à délicatesse le séparer de avec ce le blesser le mari ne être vertu et de cœur de bonté revêtir le amant avoir le amour et le tendresse amphitryon en vérité moquer de ce langage et je avoir peur ne croire sage de être écouter ce discours être raisonnable Alcmène ne penser mais long séjour je coupable et de_le à_le port le moment être presser adieu de mon devoir le étrange barbarie temps je arracher de mais beau Alcmène à_le moins voir le époux songer à le amant je prier je ne séparer point ce unir le dieu et le époux et le amant je être fort précieux ô ciel de aimable caresse de époux ardemment chérir et mon traître de mari être loin de ce tendresse le nuit il je falloir avertir ne avoir à plier voile et effacer le étoile le soleil de lit pouvoir maintenant sortir ce être ainsi le je quitte et comment donc ne vouloir de mon devoir je je acquitter et de amphitryon je aller le mais avec ce brusquerie traître de je séparer le beau de fâcherie nous avoir de temps ensemble à demeurer mais partir ainsi de façon brutal je dire mot de douceur régaler diantre vouloir mon esprit aller chercher de_le faribole an de mariage épuiser le et depuis long temps nous nous être dire regarder traître amphitryon voir combien Alcmène il étaler de flamme et rougir là-dessus de_le de passion témoigne femme hé mon Dieu cléantir il être encore amant il être certain âge passer et ce leur seoir bien dans ce commencement en nous vieux marier avoir mauvais grâce il nous faire beau voir attacher face à face à pousser le beau sentiment être je hors de état perfide de espérer cœur auprès de je soupirer non je ne avoir garde de le dire mais je être barbon oser soupirer et je faire crever de rire mérite pendard ce insigne bonheur de voir épouse femme de honneur mon Dieu ne être honnête ce grand honneur ne je valoir ne être point femme de bien et je rompre moins le tête comment de "Malheureusement cette commande tm_map() fonctionne mal,
et il est préférable de nettoyer le texte “à l’ancienne”, en créant sa
propore fonction.
#Je recharge mon corpus
corpus_clean <- tm_map(corpus_clean, PlainTextDocument)
#je crée une fonction a deux paramètres: le corpus d'entrée et la liste des stopwords.
removeStopWords <- function(corpus_a_nettoyer, stopwords_a_retirer){
# je fais une boucle pour retirer chaque mot de `stopwords_a_retirer`
for (word in stopwords_a_retirer){
#J'utilise une fonction anonyme (_snonymous function_) à un paramètre qui utilise la fonction `gsub` qui remplace le mot de `stopwords_a_retirer` par rien.
removeWord <- function(x) gsub(paste("(^|\\s)(",word,") ", sep="")," ",x)
#on retire le mot
corpus_a_nettoyer <- tm_map(corpus_a_nettoyer, removeWord)
}
#Je renvoie le résultat
return(corpus_a_nettoyer)
}
#Je passe mon `corpus_clean` comme `corpus_a_nettoyer` et mes `stopword_enLigne` comme `stopwords_a_retirer`.
corpus_clean <- removeStopWords(corpus_clean, stopword_enLigne)S’il reste des mots qui ne me plaisent pas, je peux continuer de les retirer en les mettant dans un vecteur
MesStopWords <- c( "à_le", "de_le", "-être", "faire", "falloir", "savoir", "pouvoir", "devoir", "devoir", "voir", "vouloir")
corpus_cleaner <- tm_map(corpus_clean, removeWords, MesStopWords)## Warning in tm_map.SimpleCorpus(corpus_clean, removeWords, MesStopWords):
## transformation drops documentsinspect(corpus_cleaner[6])## <<SimpleCorpus>>
## Metadata: corpus specific: 1, document level (indexed): 0
## Content: documents: 1
##
## [1] " frayeur âme blesser moindre choc entendre horreur pensée jamais consoler coup menacer laurier couronne vainqueur part honneur suprême valoir coûter tendresse cœur moment trembler aimer feu augmenter marquer œil cœur enflammer avouer chose charmant trouver amour objet aimer oser scrupule gêne tendre sentiment goûter amour Alcmène entrer ardeur faveur recevoir qualité époux point donner nom pourtant ardeur brûler droit paraître jour comprendre scrupule embarrasser amour ardeur tendresse passer époux moment doux délicatesse concevoir point cœur amoureux petit égard attacher étude inquiétude manière heureux charmant Alcmène mari amant amant toucher franchement sens mari gêne amant vœu jaloux point souhaite cœur abandonner passion point mari donner source obtenir ardeur nœud hyménée fâcheux agir coeur jour faveur douceur empoisonner scrupule combattre satisfaire délicatesse séparer blesser mari vertu cœur bonté revêtir amant amour tendresse amphitryon vérité moquer langage peur croire sage écouter discours raisonnable Alcmène penser long séjour coupable port moment presser adieu étrange barbarie temps arracher Alcmène époux songer amant prier séparer point unir dieu époux amant fort précieux ciel aimable caresse époux ardemment chérir traître mari loin tendresse nuit avertir plier voile effacer étoile soleil lit sortir quitte acquitter amphitryon aller brusquerie traître séparer fâcherie temps ensemble demeurer partir brutal douceur régaler diantre esprit aller chercher faribole an mariage épuiser long temps regarder traître amphitryon Alcmène étaler flamme rougir là-dessus passion témoigne femme Dieu cléantir amant âge passer seoir commencement vieux marier mauvais grâce attacher face face pousser sentiment perfide espérer cœur auprès soupirer garde barbon oser soupirer crever rire mérite pendard insigne bonheur épouse femme honneur Dieu honnête grand honneur valoir point femme rompre tête "Je fais de nouveau une matrice “terme/document” (DTM, Document-term matrix). On se rappelle qu’il s’agit de créer une matrice (un tableau) avec une colonne pour chaque mot de mon corpus, et un rang par texte de mon corpus.
| mot1 | mot2 | mot3 | |
|---|---|---|---|
| Texte1 | 1 | 12 | 9 |
| Texte2 | 1 | 154 | 4 |
dtm <- DocumentTermMatrix(corpus_cleaner)
rownames(dtm) <- theatre$genre2.2 Les mots peu fréquents
Je peux désormais observer la fréquence des mots: je retrouve la loi de Zipf dans la distribution de mes données
freq <- as.data.frame(colSums(as.matrix(dtm)))
colnames(freq) <- c("frequence")
#Comme je vais dessiner un graph, j'ai besoin d'une nouvelle librairie: `ggplot2`
if (!require("ggplot2")){
install.packages("ggplot2")
library("ggplot2")
}## Le chargement a nécessité le package : ggplot2##
## Attachement du package : 'ggplot2'## L'objet suivant est masqué depuis 'package:NLP':
##
## annotate#Je dessine mon graph
ggplot(freq, aes(x=frequence)) + geom_density()
Je peux compter les mots avec des fréquences faibles, par exemple avec moins de 100 occurrences
#Je retire tous les mots qui apparaissent entre 0 et 400 fois (on peut remplacer 400 par 100, ou même 10 si le corpus est trop gros)
motsPeuFrequents <- findFreqTerms(dtm, 0, 400)
#Si vous êts sur windows, décommentez la ligne suivante
#Encoding(motsPeuFrequents)<-"latin-1"
length(motsPeuFrequents)## [1] 8550head(motsPeuFrequents,50)## [1] "admirer" "agir" "aile" "aise" "alcmène"
## [6] "allure" "amoureux" "amphitryon" "ardeur" "arrêter"
## [11] "artifice" "asseoir" "aventure" "aviser" "badinage"
## [16] "beauté" "besoin" "bout" "béotique" "bête"
## [21] "cause" "censeur" "cesse" "chaise" "chaleur"
## [26] "changement" "charmant" "cheval" "chérir" "commander"
## [31] "comprendre" "cruel" "cygne" "daigner" "dame"
## [36] "decorum" "descendre" "destin" "devenir" "deviner"
## [41] "divinité" "don" "doucement" "douceur" "doute"
## [46] "doux" "déguisement" "délicieux" "désirer" "emploi"Je peux aussi compter et afficher les mots les plus fréquents, par exemple avec plus de 400 occurrences
motsTresFrequents <- findFreqTerms(dtm, 401, Inf)
#Si vous êts sur windows, décommentez la ligne suivante
#Encoding(motsTresFrequents)<-"latin-1"
length(motsTresFrequents)## [1] 65head(motsTresFrequents,50)## [1] "aimer" "aller" "amour" "attendre" "chose" "ciel"
## [7] "connaître" "coup" "croire" "cœur" "dieu" "donner"
## [13] "foi" "fort" "gloire" "homme" "jamais" "jour"
## [19] "mal" "mettre" "oui" "passer" "penser" "plaire"
## [25] "point" "prendre" "seigneur" "soin" "sortir" "trouver"
## [31] "venir" "âme" "œil" "affaire" "esprit" "grand"
## [37] "honneur" "madame" "monde" "monsieur" "mort" "nom"
## [43] "porter" "raison" "temps" "chercher" "entendre" "lieu"
## [49] "main" "perdre"Je fais un très grand ménage, avec une fonction que je crée pour retirer les mots les moins fréquents:
#Je crée une fonction `grandMenage`
grandMenage <- function(corpus_a_nettoyer, mots_peu_importants){
#Afin de simplifier le travail (de mon ordinateur), je vais rassembler les mots à retirer en groupe 500 tokens, que je vais traiter séparément.
chunk <- 500
#Je compte le nombre de mots à retirer
n <- length(mots_peu_importants)
#Je compte les groupes de 500 (ici 17.05), j'arrondis au plus petit entier supérieur (ici 18)
r <- rep(1:ceiling(n/chunk),each=chunk)[1:n]
#Je constitue mes lots sur la base du décompte précédemment mentionné
d <- split(mots_peu_importants,r)
#Je fais une boucle: pour retirer les mots du corpus, morceau par morceau
for (i in 1:length(d)) {
corpus_a_nettoyer <- tm_map(corpus_a_nettoyer, removeWords, c(paste(d[[i]])))
}
#Je renvoie un résultat
return(corpus_a_nettoyer)
}
# J'utilise ma fonction avec `corpus_clean` comme ` corpus_a_nettoyer` et `motsPeuFrequents` comme `mots_peu_importants`
corpus_cleanSuperClean <- grandMenage(corpus_cleaner, motsPeuFrequents)## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documentsJe redéfinis ma matrice à partir de mon nouveau corpus
dtm <- DocumentTermMatrix(corpus_cleanSuperClean)
rownames(dtm) <- theatre$genre
freq <- as.data.frame(colSums(as.matrix(dtm)))
colnames(freq) <- c("frequence")
#Je fais un petit graph
ggplot(freq, aes(x=frequence)) + geom_density()
Je nettoye un peu ma DTM pour éliminer les rangs vides
rowTotals <- apply(dtm , 1, sum) #Find the sum of words in each Document
dtm_clean <- dtm[rowTotals> 0, ] #remove all docs without words3. Topic modeling
Remarque préliminaire: le topic modeling requiert des (très) grands corpus, si possible en centaines de documents. Pas de panique cependant: une manière de les obtenir est de diviser chaque textes en plusieurs documents qui forment une unité sémantique. Par exemple le chapitre, la scène, le paragraphe, ou bien (comme c’est le cas pour notre exercice) de 1000 mots.
3.1 Explication théorique
Un thème (topic) est un clusters de mots, i.e. une récurrence de co-occurrence.
100% center
Source: Wikisource
Le principe du topic modeling est proche de celui de surligner un texte avec plusieurs couleurs: une pour chaque sujet, thème ou topic.
100% center
Une telle image soulève deux questions sur lesquelles nous reviendront plus tard: * un article peut-il contenir plusieurs sujets? * un mot peut-il n’appartenir qu’à un seul sujet?
Afin de reconnaître ces sujets, on va recourir à une allocation de
Dirichlet latente ( Latent Dirichlet allocation, LDA). * C’est
une approche non supervisée, c’est-à-dire qu’elle ne nécessite pas
d’annotation préalable de données. * Il nous faut définir à l’avance un
nombre de sujets/thèmes (infra la variable k)
Le LDA est modèle génératif probabiliste permettant d’expliquer des ensembles d’observations, par le moyen de groupes non observés, eux-mêmes définis par des similarités de données.
150% center
Source: wikipedia
Dans ce graph: * M est le nombre de documents (corpus) * N est le nombre de mots (document) * W est un mot observé
La partie latente (cachée): * Z est un topic attribué à un w * θ est le mélange des topics à l’échelle du document
Deux paramètres pour la distribution * α est la distribution par document. Si sa valeur est élevée, le document tend à contenir plusieurs topics, si la valeur est faible le nombre de topics est limité * β est la distribution par topic. Si sa valeur est élevée, un même mot se retrouve dans plusieurs topics (qui se ressemblent donc), si la valeur est faible les similarités entre les topics est faible
150% center
Source: wikipedia
3.2 Une LDA
Le modèle va classer aléatoirement tous les mots en n sujets, et tenter d’affiner cette répartition de manière itérative en observant les contextes:
#J'installe une nouvelle librairie pour le _topic modeling_
if(!require("topicmodels")){
install.packages("topicmodels")
library("topicmodels")
}## Le chargement a nécessité le package : topicmodels#Je vais partir sur une classification en deux _topics_
k = 2
lda_2 <- LDA(dtm_clean, k= k, control = list(seed = 1234))
##Je tente avec trois, pour voir…
lda_3 <- LDA(dtm_clean, k= k+1, control = list(alpha = 0.1))Le résultat produit est une matrice avec pour chaque mot la probabilité qu’il appartienne à un des différents topics. On donne un score β, qui est celui présenté infra.
topics <- tidy(lda_2, matrix = "beta")
topics## # A tibble: 848 × 3
## topic term beta
## <int> <chr> <dbl>
## 1 1 aimer 0.0200
## 2 2 aimer 0.0202
## 3 1 alcmène 0.000349
## 4 2 alcmène 0.00106
## 5 1 aller 0.0303
## 6 2 aller 0.0571
## 7 1 amour 0.0130
## 8 2 amour 0.0302
## 9 1 attendre 0.00547
## 10 2 attendre 0.0151
## # … with 838 more rows3.3 Les paramètres de Gibbs
Les paramètres de Gibbs permettent une sophistication du système précédent. C’est une probabilité conditionnelle qui s’appuie, pour calculer le β d’un mot, sur le β des mots voisins. Pour ce faire nous devons déterminer: 1. À quel point un document aime un topic 2. À quel pount un topic aime un mot
Un document:
| Voiture | Autoroute | Musique | Vélo | Vacances |
|---|---|---|---|---|
| 1 | ?? | 2 | 1 | 3 |
Sachant que le décompte est le suivant
| topic 1 | topic 2 | topic 3 | |
|---|---|---|---|
| Voiture | 34 | 49 | 75 |
| Autoroute | 150 | 50 | 70 |
| Musique | 34 | 4 | 170 |
| Vélo | 543 | 2 | 150 |
| Vacances | 23 | 70 | 563 |
Le topic 1 est le plus représenté dans le document, et Autoroute est déjà surreprésenté dans le décompte, donc on update le tout
| Voiture | Autoroute | Musique | Vélo | Vacances |
|---|---|---|---|---|
| 1 | 1 | 2 | 1 | 3 |
| topic 1 | topic 2 | topic 3 | |
|---|---|---|---|
| Voiture | 34 | 49 | 75 |
| Autoroute | 151 | 50 | 70 |
| Musique | 34 | 4 | 170 |
| Vélo | 543 | 2 | 150 |
| Vacances | 23 | 70 | 563 |
Nous devons d’abord déterminer le nombre optimal de topics
#J'installe une nouvelle librairie pour déterminer le nombre de topics
if(!require("ldatuning")){
install.packages("ldatuning")
library("ldatuning")
}## Le chargement a nécessité le package : ldatuning#J'exécute le calcul
topicsNumber <- FindTopicsNumber(
#La DTM que j'utilise
dtm_clean,
#Le nombre de possibilités que je teste
topics = seq(from = 2, to = 20, by = 1),
#Les métriques utilisées
metrics = c("Griffiths2004", "CaoJuan2009", "Arun2010", "Deveaud2014"),
method = "Gibbs",
control = list(seed = 77),
verbose = TRUE
)## fit models... done.
## calculate metrics:
## Griffiths2004... done.
## CaoJuan2009... done.
## Arun2010... done.
## Deveaud2014... done.#J'affiche le résultat
FindTopicsNumber_plot(topicsNumber)## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.
## Set parameters for Gibbs sampling
#Le modèle va tourner 2000 fois avant de commencer à enregistrer les résultats
burnin <- 2000
#Après cela il va encore tourner 2000 fois
iter <- 2000
# Il ne va enregistrer le résultat que toutes les 500 itérations
thin <- 500
#seed et nstart pour la reproductibilité
SEED=c(1, 2, 3, 4, 5)
seed <-SEED
nstart <- 5
#Seul meilleur modèle est utilisé
best <- TRUE
#7 topics
lda_gibbs_7 <- LDA(dtm_clean, 7, method="Gibbs", control=list(nstart=nstart, seed=seed, best=best, burnin=burnin, iter=iter, thin=thin))
#19 topics
lda_gibbs_19 <- LDA(dtm_clean, 19, method="Gibbs", control=list(nstart=nstart, seed=seed, best=best, burnin=burnin, iter=iter, thin=thin))Je peux désormais voir les premiers résultats pour chacun des modèles. Il s’agit de de mots dont la fréquence d’utilisation est corrélée
"LDA 2"## [1] "LDA 2"termsTopic <- as.data.frame(terms(lda_2,10))
head(termsTopic,11)## Topic 1 Topic 2
## 1 venir point
## 2 monsieur aller
## 3 point cœur
## 4 prendre amour
## 5 aller donner
## 6 madame monsieur
## 7 homme croire
## 8 jamais chose
## 9 œil mettre
## 10 père oui"LDA 3"## [1] "LDA 3"termsTopic <- as.data.frame(terms(lda_3,10))
head(termsTopic,11)## Topic 1 Topic 2 Topic 3
## 1 cœur monsieur seigneur
## 2 point aller aller
## 3 madame point point
## 4 aimer venir œil
## 5 amour chose cœur
## 6 aller oui dieu
## 7 prendre donner madame
## 8 âme homme roi
## 9 venir prendre venir
## 10 croire père fils"LDA GIBBS 7"## [1] "LDA GIBBS 7"termsTopic <- as.data.frame(terms(lda_gibbs_7,10))
head(termsTopic,11)## Topic 1 Topic 2 Topic 3 Topic 4 Topic 5 Topic 6 Topic 7
## 1 point prendre aller madame cœur monsieur dieu
## 2 venir grand point ciel amour chose seigneur
## 3 père esprit venir sortir aimer homme fils
## 4 fille mal coup jour âme fort roi
## 5 oui trouver porter frère croire oui œil
## 6 demander mettre entendre mort œil monde sang
## 7 aller point donner vie soin donner craindre
## 8 honneur plaire mieux mourir gloire femme main
## 9 croire jamais foi perdre attendre affaire nom
## 10 jamais raison connaître main lieu trouver chercher"LDA GIBBS 19"## [1] "LDA GIBBS 19"termsTopic <- as.data.frame(terms(lda_gibbs_19,10))
head(termsTopic,11)## Topic 1 Topic 2 Topic 3 Topic 4 Topic 5 Topic 6 Topic 7 Topic 8
## 1 madame grand seigneur cœur croire oui monsieur aller
## 2 croire esprit œil âme point donner chose venir
## 3 point prendre attendre œil aller fort donner foi
## 4 soin fort jour sortir foi trouver affaire donner
## 5 perdre trouver craindre soin passer venir mettre attendre
## 6 jour vrai rome souffrir jamais grand homme oui
## 7 penser jamais entendre jamais grâce point monde -ten
## 8 connaître passer gloire amour penser raison prendre connaître
## 9 amour lieu lieu trouver souffrir entendre porter porter
## 10 foi connaître temps alcmène raison léandre fort entendre
## Topic 9 Topic 10 Topic 11 Topic 12 Topic 13 Topic 14 Topic 15 Topic 16
## 1 roi père aimer fils prendre frère ciel chose
## 2 chercher fille amour seigneur mal mourir honneur homme
## 3 gloire aller cœur sang mettre mort point femme
## 4 lieu point œil œil point main demander monde
## 5 grand demander plaire craindre plaire sang vie trouver
## 6 attendre venir main père raison sortir souffrir affaire
## 7 connaître donner myrtil mort croire vie connaître vrai
## 8 alexandre raison gloire chercher penser perdre prendre mieux
## 9 croire iphigénie xipharès pyrrhus jamais ciel grâce aristote
## 10 main honneur chercher grèce tartuffe jour don plaire
## Topic 17 Topic 18 Topic 19
## 1 point dieu venir
## 2 donner jour coup
## 3 mieux ciel porter
## 4 plaire main jamais
## 5 venir nom entendre
## 6 grâce sortir sortir
## 7 temps œil grand
## 8 penser entendre perdre
## 9 passer temps passer
## 10 vrai david allerNous allons utiliser lda_gibbs_2 et construire une
matrice avec les β des tokens (pour les ɣ, et donc des
probabilités par document, on aurait mis matrix = "gamma").
Chaque token est répété deux fois, avec une probabilité pour chaque
topic:
topics <- tidy(lda_gibbs_7, matrix = "beta")
topics## # A tibble: 2,968 × 3
## topic term beta
## <int> <chr> <dbl>
## 1 1 aimer 0.0000136
## 2 2 aimer 0.0000134
## 3 3 aimer 0.000150
## 4 4 aimer 0.0000134
## 5 5 aimer 0.138
## 6 6 aimer 0.0000118
## 7 7 aimer 0.0000119
## 8 1 alcmène 0.0000136
## 9 2 alcmène 0.0000134
## 10 3 alcmène 0.0000136
## # … with 2,958 more rows4. Visualisation
#Je vais encore solliciter une nouvelle librairie
if (!require("dplyr")){
install.packages("dplyr")
library("dplyr")
}## Le chargement a nécessité le package : dplyr##
## Attachement du package : 'dplyr'## Les objets suivants sont masqués depuis 'package:stats':
##
## filter, lag## Les objets suivants sont masqués depuis 'package:base':
##
## intersect, setdiff, setequal, union#Je récupère mes mots
top_terms <- topics %>%
group_by(topic) %>%
top_n(10, beta) %>%
ungroup() %>%
arrange(topic, -beta)
#Je fais un graph
top_terms %>%
mutate(term = reorder_within(term, beta, topic)) %>%
ggplot(aes(term, beta, fill = factor(topic))) + geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free") +
coord_flip() +
scale_x_reordered()
Je vais désormais associer chaque mot à l’un des 5 genres possibles, pour déterminer auquel mes tokens sont rattachés, et découvrir (potentiellement quel genre se cacher derrière quel topic
if (!require("reshape2")){
install.packages("reshape2")
library("reshape2")
}## Le chargement a nécessité le package : reshape2df <- melt(as.matrix(dtm_clean))
df <- df[df$Terms %in% findFreqTerms(dtm_clean, lowfreq = 800), ]
ggplot(df, aes(as.factor(Docs), Terms, fill=log(value))) +
geom_tile() +
xlab("Genres") +
scale_fill_continuous(low="#FEE6CE", high="#E6550D") +
theme(axis.text.x = element_text(angle=90, hjust=1))
tt <- posterior(lda_gibbs_7)$terms
melted = melt(tt[,findFreqTerms(dtm_clean, 1000,10000)])
colnames(melted) <- c("Topics", "Terms", "value")
melted$Topics <- as.factor(melted$Topics)
ggplot(data = melted, aes(x=Topics, y=Terms, fill=value)) +
geom_tile() +
theme(text = element_text(size=35))
tt <- posterior(lda_gibbs_19)$terms
melted = melt(tt[,findFreqTerms(dtm_clean, 1000,10000)])
colnames(melted) <- c("Topics", "Terms", "value")
melted$Topics <- as.factor(melted$Topics)
ggplot(data = melted, aes(x=Topics, y=Terms, fill=value)) +
geom_tile() +
theme(text = element_text(size=35))
On peut aussi observer le score gamma, c’est-à-dire la probabilté qu’un document contienne un sujet:
DocumentTopicProbabilities <- as.data.frame(lda_gibbs_19@gamma)
rownames(DocumentTopicProbabilities) <- rownames(corpus_cleanSuperClean)
head(DocumentTopicProbabilities)## V1 V2 V3 V4 V5 V6 V7
## 1 0.03103914 0.03958614 0.03958614 0.07377418 0.08232119 0.03958614 0.02249213
## 2 0.08859649 0.10526316 0.04692982 0.13026316 0.03026316 0.02192982 0.08026316
## 3 0.06009117 0.06009117 0.04434314 0.06796519 0.03646913 0.08371322 0.02072109
## 4 0.02174859 0.09612875 0.02174859 0.07133536 0.03001305 0.06307090 0.03001305
## 5 0.02349624 0.12171053 0.02349624 0.07706767 0.03242481 0.03242481 0.04135338
## 6 0.03301435 0.05119617 0.02392344 0.15119617 0.07846890 0.03301435 0.02392344
## V8 V9 V10 V11 V12 V13 V14
## 1 0.03103914 0.03103914 0.02249213 0.03958614 0.02249213 0.05668016 0.02249213
## 2 0.06359649 0.03026316 0.03026316 0.02192982 0.03026316 0.03026316 0.02192982
## 3 0.08371322 0.04434314 0.02072109 0.04434314 0.02072109 0.07583920 0.04434314
## 4 0.03827751 0.02174859 0.02174859 0.02174859 0.02174859 0.04654197 0.05480644
## 5 0.03242481 0.06813910 0.04135338 0.05028195 0.04135338 0.08599624 0.05921053
## 6 0.03301435 0.04210526 0.03301435 0.09665072 0.02392344 0.02392344 0.02392344
## V15 V16 V17 V18 V19
## 1 0.05668016 0.06522717 0.06522717 0.19343230 0.06522717
## 2 0.05526316 0.05526316 0.03859649 0.08026316 0.03859649
## 3 0.05221716 0.07583920 0.04434314 0.06009117 0.06009117
## 4 0.04654197 0.07133536 0.08786429 0.12092214 0.11265768
## 5 0.03242481 0.07706767 0.02349624 0.05921053 0.07706767
## 6 0.06937799 0.06028708 0.07846890 0.08755981 0.03301435Nous allons désormais faire des word clouds. Pour cela appelons (installons?) les libraries suivantes:
if (!require("wordcloud")){
install.packages("wordcloud")
library("wordcloud")
}## Le chargement a nécessité le package : wordcloud## Le chargement a nécessité le package : RColorBrewerif (!require("RColorBrewer")){
install.packages("RColorBrewer")
library("RColorBrewer")
}
if (!require("wordcloud2")){
install.packages("wordcloud2")
library("wordcloud2")
}## Le chargement a nécessité le package : wordcloud2je récupère les mots et je les associe à leur 𝛃
tm <- posterior(lda_gibbs_7)$terms
data = data.frame(colnames(tm))
head(data)## colnames.tm.
## 1 aimer
## 2 alcmène
## 3 aller
## 4 amour
## 5 attendre
## 6 choseJe produis une visualisation par topic
for(topic in seq(k)){
data$topic <-tm[topic,]
#text(x=0.5, y=1, paste("V",topic, sep=""),cex=0.6)
wordcloud(
words = data$colnames.tm.,
freq = data$topic,
#sous ce seuil, les mots ne seront pas affichés
min.freq=0.0002,
#nombre maximum de mots à afficher
max.words=30,
#Si faux, en ordre croissant
random.order=FALSE,
#% de mots à 90°
rot.per=.35,
#taille du graph
scale=c(10,10),
#couleurs
colors = brewer.pal(5, "Dark2")
# il est possible de rentrer directement les couleurs qui nous intéressent
#c("red", "blue", "yellow", "chartreuse", "cornflowerblue", "darkorange")
)
}## Warning in wordcloud(words = data$colnames.tm., freq = data$topic, min.freq =
## 2e-04, : ascagne could not be fit on page. It will not be plotted.
Finissons avec un peu de mauvais goût, grâce au package
wordcloud2
wordcloud2(data = data,
size=0.4,
color= "random-light",
backgroundColor = "pink",
shape = 'star',
rotateRatio=1
)Rermerciements
Les données d’entraînement ont été créées par JB Camps (ENC). Des morceaux de ce script (notamment pour le nettoyage des données) proviennent d’un cours de Mattia Egloff (UniL).